Code: Select all
; /*
; *
; * Copyright (c) 2002-2005 by Danilo Krahn
; *
; * This library is free software; you can redistribute it and/or
; * modify it under the terms of the GNU Lesser General Public
; * License As published by the Free Software Foundation; either
; * version 2.1 of the License, Or (at your option) any later version.
; *
; * This library is distributed in the hope that it will be useful,
; * but WITHOUT ANY WARRANTY; without even the implied warranty of
; * MERCHANTABILITY Or FITNESS For A PARTICULAR PURPOSE. See the GNU
; * Lesser General Public License For more details.
; *
; */
; changed from C to PB by ts-soft
; Diese Include enthält alle Funktionen der PBOSL_Timer Lib von Danilo Krahn
; Die Funktionsnamen wurden angepaßt, um konflikte mit der UserLib zu vermeiden
; Desweiteren ist vor Verwendung der Funktionen Timer_Init() aufzurufen
; Am Ende dann Timer_End()
; StartTimer() = TimerStart()
; EndTimer() = TimerStop()
; GetMinTimerResolution() = TimerGetMinRes()
; GetMaxTimerResolution() = TimerGetMaxRes()
Define TimerResolution.TIMECAPS
Global Dim TimerHandles(15)
Global Dim TimerProcedures(15)
Procedure Timer_Init()
Shared TimerResolution
If timeGetDevCaps_(@TimerResolution, SizeOf(TIMECAPS)) = #TIMERR_NOERROR
If timeBeginPeriod_(TimerResolution\wPeriodMin) = #TIMERR_NOERROR
ProcedureReturn #True
EndIf
EndIf
ProcedureReturn #False
EndProcedure
Procedure Timer_End()
Protected I
Shared TimerResolution
timeEndPeriod_(TimerResolution\wPeriodMin)
For I = 0 To 15
If TimerHandles(I)
timeKillEvent_(TimerHandles(I))
EndIf
Next
EndProcedure
Procedure Timer_Callback(TimerHandle, Message, TimerID, wParam, lParam)
If TimerProcedures(TimerID)
CallFunctionFast(TimerProcedures(TimerID))
EndIf
EndProcedure
Procedure StartTimer(TimerID, Delay, ProcAddr)
If TimerID > 15 Or TimerID < 0 : ProcedureReturn #False : EndIf
If TimerHandles(TimerID)
timeKillEvent_(TimerHandles(TimerID))
EndIf
TimerProcedures(TimerID) = ProcAddr
TimerHandles(TimerID) = timeSetEvent_(Delay, 0, @Timer_Callback(), TimerID, #TIME_PERIODIC)
ProcedureReturn TimerHandles(TimerID)
EndProcedure
Procedure EndTimer(TimerID)
If TimerID > 15 Or TimerID < 0 : ProcedureReturn #False : EndIf
If TimerHandles(TimerID)
timeKillEvent_(TimerHandles(TimerID))
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure TimerGetMaxRes()
Shared TimerResolution
ProcedureReturn TimerResolution\wPeriodMax
EndProcedure
Procedure TimerGetMinRes()
Shared TimerResolution
ProcedureReturn TimerResolution\wPeriodMin
EndProcedure
;===========================================================================================================================
; Copyright to Fangbeast(c) 2003 :):) The CAB procedures (function enumerations), DLL handling and examples were the product
; of P.Leischow, everything else is mine, Mine, MIne, MINe, MINE I tell you!! (Okay, I'll take a pill and calm down)
;
; Okay, I just did this clean code to help anyone else who; like me; has been needing CAB decompression for the last year
; and a half. I have been asking for ages and no-one seemed to take it seriously, even though the industry at large STILL
; use CABinet compression and decompression in a great many products. And, until P Leischow came out with his initial CAB
; decompression routine, I was totally lost. Then he kindly mailed me some even more useful routine to deCAB files as well.
;
; I must also seriously thank Rings for getting me started on this. In his limited amount of time, he gave me some trial
; compression code to get me started on the idea. There are some really nice programmers in the forum and Rings is one of
; them.
;
; This little program is a proof-of-concept for something I needed in my main software (that I had been writing and
; re-writing for the better part of two years and I wanted everyone else to have it because by itself it is also terribly
; useful Well, to some people anyway,
;
; Simply put, you can create your own ms format CABinet archives and add single files, multiple files or whole directories
; to it. At this point however, there is no path information stored in the archive (I didn't need that feature initially)
; but I am hoping for the sake of extended functionality that this will come. The way I lay out code, most experienced code
; whackers will have no trouble working this out. It's neat, tidy and works. Some nice features like form and object
; resizing, blinking progress mode, error messages, cute tooltip and single task locking etc. Have fun with it, do what you
; Like with it but remember to thank the authors please.
;
; You will need cab10.dll and I'll find somewhere to post it or ask me to email it to you.
;
;===========================================================================================================================
; All program constants
;===========================================================================================================================
#DLL = 0 ; CAB dll variable for library functions
Enumeration ; Window Constants
#Window_cabboy
EndEnumeration
#WindowIndex = #PB_Compiler_EnumerationValue
Enumeration ; Gadget Constants
#Gadget_cabboy_Main_Frame ; Main window frame
#Gadget_cabboy_Cab_Name_Label ; Label for cab file name
#Gadget_cabboy_Cab_Name ; CAB file name box
#Gadget_cabboy_Set_Pack_Name ; Button to get CAB file name
#Gadget_cabboy_List_Frame ; List box frame
#Gadget_cabboy_List_Members ; List of filenames to pack
#Gadget_cabboy_Control_Frame ; Frame for control buttons
#Gadget_cabboy_Add_Files ; Button to get files to pack
#Gadget_cabboy_Add_Directories ; Add directories
#Gadget_cabboy_Make_Cab_File ; Button to make the CAB file
#Gadget_cabboy_Exit_Program ; Button to exit the program
#Gadget_cabboy_Status_Box ; Status messages box
EndEnumeration
#GadgetIndex = #PB_Compiler_EnumerationValue
;===========================================================================================================================
; Need a list to hold enumerated cab members in (for decompress functions)
;===========================================================================================================================
NewList CabFileList.s()
NewList DirEntries.s()
;===========================================================================================================================
; Setup more readable and typable library functions
;===========================================================================================================================
If OpenLibrary(#DLL,"cab10.dll")
CabAbout =GetFunction(#DLL,"CABABOUT")
CabCompressInitialize =GetFunction(#DLL,"CABCOMPRESSINITIALIZE")
CabDecompressInitialize =GetFunction(#DLL,"CABDECOMPRESSINITIALIZE")
CabCreate =GetFunction(#DLL,"CABCREATE")
CabAddFile =GetFunction(#DLL,"CABADDFILE")
CabClose =GetFunction(#DLL,"CABCLOSE")
CabEnum =GetFunction(#DLL,"CABENUM")
CabExtract =GetFunction(#DLL,"CABEXTRACT")
CabCompressTerminate =GetFunction(#DLL,"CABCOMPRESSTERMINATE")
CabDecompressTerminate =GetFunction(#DLL,"CABDECOMPRESSTERMINATE")
Else
MessageRequester("Error","Could Not Load DLL",#MB_ICONERROR)
End
EndIf
;===========================================================================================================================
; Get the current working directory for later functions (may or may not use it)
;===========================================================================================================================
CurrentDirectory.s = Space(256)
GetCurrentDirectory_(Len(CurrentDirectory.s), @CurrentDirectory)
If Right(CurrentDirectory.s, 1) <> "\"
CurrentDirectory.s + "\"
EndIf
;===========================================================================================================================
; Any global variables we need
;===========================================================================================================================
Global OriginalWidth, OriginalHeight, ProcMutex, TimerTicks.l, ProgramVersion.s
;===========================================================================================================================
; Set the global program version number
;===========================================================================================================================
ProgramVersion.s = "CAB Boy"
;===========================================================================================================================
; Any needed procedural declarations (Hope I got them in the right order)
;===========================================================================================================================
Declare.l Window_cabboy()
Declare Resize_Callback(WindowID, Message, wParam, lParam)
Declare Tool_Tip(Handle, Text.s) ; Windows API routine for fancy bubble tooltip
Declare Blink_Message() ; Timer working messae for any long event
Declare Reset_Title() ; Blink a message on and off, one second apart
Declare Status_Message(Message.s) ; Shorten typing for message strings
Declare.s CabAbout() ; Paul Leischow's CABinet compress/decompress routines
Declare.l CabDecompressInitialize()
Declare.l CabEnum(Source.s)
Declare.l CabExtract(Source.s, Destination.s)
Declare.l CabDecompressTerminate()
Declare.l CabCompressInitialize()
Declare.l CabCreate(Destination.s)
Declare.l CabAddFile(hCab, Source.s, Destination.s)
Declare.l CabClose(hCab.l)
Declare.l CabCompressTerminate()
;===========================================================================================================================
; Main program event handler
;===========================================================================================================================
If Window_cabboy() ; Main Loop
If CreateFile(0, CurrentDirectory.s + "cab10.dll") ; Write the cab dll to the current directory
WriteData(0,?CabDll, ?EndCab - ?CabDll)
CloseFile(0)
EndIf
SetWindowCallback(@Resize_Callback()) ; Screen and object resizing
QuitCabBoy = 0
Repeat
EventID = WaitWindowEvent()
Select EventID
Case #PB_Event_CloseWindow
If EventWindow() = #Window_cabboy
QuitCabBoy = 1
EndIf
Case #PB_Event_Gadget
Select EventGadget()
Case #Gadget_cabboy_Set_Pack_Name : Gosub Set_Pack_Name ; Setup the name of the CABinet file and display it to the user
;----------------------------------------------------------------------------------------
Case #Gadget_cabboy_List_Members ; Select event happening on list gadget
Select EventType()
Case #PB_EventType_LeftDoubleClick : Gosub Remove_File ; Remove a file from the list
Case #PB_EventType_RightDoubleClick : Gosub Test_Clear
Case #PB_EventType_RightClick :
Default
EndSelect
;--------------------------------------------------------------------------------------
Case #Gadget_cabboy_Add_Files : Gosub Add_Pack_Files ; Add files to the list that we pack from
Case #Gadget_cabboy_Add_Directories : Gosub Add_Pack_Directories
Case #Gadget_cabboy_Make_Cab_File : Gosub Compress_Files
Case #Gadget_cabboy_Exit_Program : QuitCabBoy = 1
EndSelect
EndSelect
Until QuitCabBoy
CloseWindow(#Window_cabboy)
EndIf
CloseLibrary(#DLL) ; Free up library resource
If DeleteFile(CurrentDirectory.s + "cab10.dll") ; Delete the included cab dll
EndIf
End
;===========================================================================================================================
; Clear the list of members if no other process is running and user selected this option
;===========================================================================================================================
Test_Clear:
If ProcMutex = 1
Return
Else
ProcMutex = 1
ClearGadgetItemList(#Gadget_cabboy_List_Members)
EndIf
ProcMutex = 0
Return
;===========================================================================================================================
; Remove a file from the list when it has been single clicked
;===========================================================================================================================
Remove_File:
If ProcMutex = 1
Return
Else
ProcMutex = 1
Current_Line = GetGadgetState(#Gadget_cabboy_List_Members)
If Current_Line <> -1
RemoveGadgetItem(#Gadget_cabboy_List_Members, Current_Line)
Status_Message("Current item has been deleted!!")
EndIf
EndIf
ProcMutex = 0
Return
;===========================================================================================================================
; Add selected directories to the list for compression
;===========================================================================================================================
Add_Pack_Directories:
If ProcMutex = 1
Return
Else
StartTimer(0, 1000, @Blink_Message())
ProcMutex = 1
ClearList(DirEntries.s())
AddDirectoryName.s = PathRequester("Add DIRectories", "")
If AddDirectoryName.s
If Right(AddDirectoryName.s, 1) = "\"
AddDirectoryName.s = Left(AddDirectoryName.s, Len(AddDirectoryName.s) - 1)
EndIf
AddElement(DirEntries())
DirEntries() = AddDirectoryName.s
Index = 0
Repeat
SelectElement(DirEntries(), Index)
If ExamineDirectory(0, DirEntries(), "*.*")
Path.s = DirEntries() + "\"
Quit = 0
Repeat
NextFile = NextDirectoryEntry(0)
FileName.s = DirectoryEntryName(0)
Select NextFile
Case 0
Quit = 1
Case 1
DiskFile.s = Path + FileName.s
AddGadgetItem(#Gadget_cabboy_List_Members, - 1, DiskFile.s)
While WindowEvent()
Wend
Case 2
FileName.s = DirectoryEntryName(0)
If FileName.s <> ".." And FileName.s <> "."
AddElement(DirEntries())
DirEntries() = Path + FileName.s
EndIf
EndSelect
Until Quit = 1
EndIf
Index + 1
Until Index > CountList(DirEntries()) -1
Else
Status_Message("Cancelled by user, no DIRectories to add")
EndIf
EndIf
ProcMutex = 0
EndTimer(0)
Reset_Title()
Return
;===========================================================================================================================
; Add selected files to the list for compression
;===========================================================================================================================
Add_Pack_Files:
If ProcMutex = 1
Return
Else
StartTimer(0, 1000, @Blink_Message())
ProcMutex = 1
AddFileName.s = OpenFileRequester("Add files", "", "All files | *.*", 0, #PB_Requester_MultiSelection)
If AddFileName.s
AddGadgetItem(#Gadget_cabboy_List_Members, -1, AddFileName.s)
Repeat
AddFileName.s = NextSelectedFileName()
If AddFileName.s
AddGadgetItem(#Gadget_cabboy_List_Members, -1, AddFileName.s)
EndIf
Until AddFileName.s = ""
Else
Status_Message("Cancelled by user, no files to add")
EndIf
EndIf
ProcMutex = 0
EndTimer(0)
Reset_Title()
Return
;===========================================================================================================================
; Set the name of the cab file to create and give error if cancelled
;===========================================================================================================================
Set_Pack_Name:
If ProcMutex = 1
Return
Else
ProcMutex = 1
CabFileName.s = SaveFileRequester("CABinet file name", "CABBoy.CAB", "*.cab", 0)
If CabFileName.s = ""
Status_Message("Cancelled by user, no output filename specified")
Else
SetGadgetText(#Gadget_cabboy_Cab_Name, CabFileName.s)
EndIf
EndIf
ProcMutex = 0
Return
;===========================================================================================================================
; Compress files into the selected CABinet file now
;===========================================================================================================================
Compress_Files:
If ProcMutex = 1
Return
Else
StartTimer(0, 1000, @Blink_Message())
ProcMutex = 1
If CabCompressInitialize()
SetGadgetText(#Gadget_cabboy_Status_Box, "Creating " + CabFileName.s)
CabFileName.s = GetGadgetText(#Gadget_cabboy_Cab_Name)
FilesToPack = CountGadgetItems(#Gadget_cabboy_List_Members)
hCabFile = CabCreate(CabFileName.s)
If hCabFile
Result = 0
For PackStart = 0 To FilesToPack - 1
CurrentFileName.s = GetGadgetItemText(#Gadget_cabboy_List_Members, PackStart, 0):Debug CurrentFileName.s
Result + CabAddFile(hCabFile, CurrentFileName.s, CurrentFileName.s)
Next PackStart
If Result
CabClose(hCabFile)
Else
Status_Message("Error, could not add files to CABinet!!")
ProcMutex = 0
Return
EndIf
Else
Status_Message("Error, no CABinet name specified!!")
ProcMutex = 0
Return
EndIf
CabCompressTerminate()
Else
Status_Message("Error, could not initialise compression")
ProcMutex = 0
Return
EndIf
Status_Message("CABinet file created successfully!!")
ClearGadgetItemList(#Gadget_cabboy_List_Members)
EndIf
ProcMutex = 0
EndTimer(0)
Reset_Title()
Return
;===========================================================================================================================
; Decompress files from a CABinet file
;===========================================================================================================================
;
;DeCompress_Files:
;
;If CabDecompressInitialize()
; Found = CabEnum(CurrentDirectory + "MyCab.cab")
; ResetList(CabFileList())
; For Tmp = 1 To Found
; NextElement(CabFileList())
; ;CabExtract(CabFileList(),CabFileList())
; Debug CabFileList()
; Next
; CabDecompressTerminate()
;EndIf
;
;Return
;
;===========================================================================================================================
; Main program window
;===========================================================================================================================
Procedure.l Window_cabboy()
If OpenWindow(#Window_cabboy,237,40,500,400, ProgramVersion.s,#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_SizeGadget|#PB_Window_Invisible)
OriginalWidth = WindowWidth(#Window_cabboy) ; Original non-client width.
OriginalHeight = WindowHeight(#Window_cabboy) ; Original non-client height.
If CreateGadgetList(WindowID(#Window_cabboy))
Frame3DGadget(#Gadget_cabboy_Main_Frame,5,0,490,40,"")
TextGadget(#Gadget_cabboy_Cab_Name_Label,15,15,75,15,"CAB file name",#PB_Text_Center)
TextGadget(#Gadget_cabboy_Cab_Name,95,15,360,15,"")
ButtonGadget(#Gadget_cabboy_Set_Pack_Name,460,15,25,15,"...")
Tool_Tip(GadgetID(#Gadget_cabboy_Set_Pack_Name), "Click this button to set the name of the CABinet file you will be adding to")
Frame3DGadget(#Gadget_cabboy_List_Frame,5,40,490,310,"")
ListIconGadget(#Gadget_cabboy_List_Members,15,55,470,285,"Filenames",500,#PB_ListIcon_MultiSelect|#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection)
Tool_Tip(GadgetID(#Gadget_cabboy_List_Members), "Double left clicking on any item in this list will remove it from the list and double right clicking on any item in the list will remove all items from the list")
SendMessage_(GadgetID(#Gadget_cabboy_List_Members),#LVM_SETBKCOLOR,0,9436387)
SendMessage_(GadgetID(#Gadget_cabboy_List_Members),#LVM_SETTEXTBKCOLOR,0,9436387)
Frame3DGadget(#Gadget_cabboy_Control_Frame,5,350,490,45,"")
ButtonGadget(#Gadget_cabboy_Add_Files,15,365,50,20,"Add files")
Tool_Tip(GadgetID(#Gadget_cabboy_Add_Files), "Click this button to addindividual files to the packing list")
ButtonGadget(#Gadget_cabboy_Make_Cab_File,115,365,50,20,"CAB it")
Tool_Tip(GadgetID(#Gadget_cabboy_Make_Cab_File), "Click this button to create the CABinet file from the list members")
ButtonGadget(#Gadget_cabboy_Exit_Program,165,365,50,20,"Exit")
Tool_Tip(GadgetID(#Gadget_cabboy_Exit_Program), "Click this button to exit this program immediately (If not sooner)")
TextGadget(#Gadget_cabboy_Status_Box,220,370,265,15,"")
Tool_Tip(GadgetID(#Gadget_cabboy_Status_Box), "Any error messages generated by the program will show up in here")
ButtonGadget(#Gadget_cabboy_Add_Directories,65,365,50,20,"Add dirs")
HideWindow(#Window_cabboy,0)
ProcedureReturn WindowID(#Window_cabboy)
EndIf
EndIf
EndProcedure
;===========================================================================================================================
;
;===========================================================================================================================
Procedure.s CabAbout()
Shared CabAbout
ProcedureReturn PeekS(CallFunctionFast(CabAbout))
EndProcedure
;===========================================================================================================================
;
;===========================================================================================================================
Procedure.l CabDecompressInitialize()
Shared CabDecompressInitialize
ProcedureReturn CallFunctionFast(CabDecompressInitialize)
EndProcedure
;===========================================================================================================================
;
;===========================================================================================================================
Procedure.l CabEnum(Source.s)
Shared CabEnum
Shared CabFileList()
Total = 0
Result$ = PeekS(CallFunctionFast(CabEnum, @Source))
If Result$ <> ""
ClearList(CabFileList())
Repeat
Total + 1
file.s = StringField(Result$, Total, Chr(9))
AddElement(CabFileList())
CabFileList() = file
Until file = ""
Total - 1
EndIf
ProcedureReturn Total
EndProcedure
;===========================================================================================================================
;
;===========================================================================================================================
Procedure.l CabExtract(Source.s, Destination.s)
Shared CabExtract
ProcedureReturn CallFunctionFast(CabExtract, @Source, @Destination)
EndProcedure
;===========================================================================================================================
;
;===========================================================================================================================
Procedure.l CabDecompressTerminate()
Shared CabDecompressTerminate
ProcedureReturn CallFunctionFast(CabDecompressTerminate)
EndProcedure
;===========================================================================================================================
;
;===========================================================================================================================
Procedure.l CabCompressInitialize()
Shared CabCompressInitialize
ProcedureReturn CallFunctionFast(CabCompressInitialize)
EndProcedure
;===========================================================================================================================
;
;===========================================================================================================================
Procedure.l CabCreate(Destination.s)
Shared CabCreate
ProcedureReturn CallFunctionFast(CabCreate, @Destination)
EndProcedure
;===========================================================================================================================
;
;===========================================================================================================================
Procedure.l CabAddFile(hCab, Source.s, Destination.s)
Shared CabAddFile
ProcedureReturn CallFunctionFast(CabAddFile, hCab, @Source, @Destination)
EndProcedure
;===========================================================================================================================
;
;===========================================================================================================================
Procedure.l CabClose(hCab.l)
Shared CabClose
ProcedureReturn CallFunctionFast(CabClose, hCab)
EndProcedure
;===========================================================================================================================
;
;===========================================================================================================================
Procedure.l CabCompressTerminate()
Shared CabCompressTerminate
ProcedureReturn CallFunctionFast(CabCompressTerminate)
EndProcedure
;============================================================================================================================
; Form and object resizing
;============================================================================================================================
Procedure Resize_Callback(WindowID, Message, wParam, lParam)
Result = #PB_ProcessPureBasicEvents
If WindowID = WindowID(#Window_cabboy) ; Only process events for this window
Select Message ; What sort of event did we get
Case #WM_GETMINMAXINFO ; Restrict the minimum size to 500x(307 + MenuHeight()), borders included
Result = 0
*ptr.MINMAXINFO = lParam
*ptr\ptMinTrackSize\x = 500 + 8
*ptr\ptMinTrackSize\y = 400 + 8 + MenuHeight()
Case #WM_SIZE ; Form's size has changed.
SetActiveWindow(#Window_cabboy) ; Use the right window
WinWidth.l = WindowWidth(#Window_cabboy) ; Get the new width of the window
WinHeight.l = WindowHeight(#Window_cabboy) ; Get the new height of the window
WidthChange = WinWidth - OriginalWidth ; Get the width difference
HeightChange = WinHeight - OriginalHeight ; Get the height difference 108,0,587,400
;-----------------------------------------------------------------------------------------------------------------
NewCollumn4Size.l = WinWidth ; 0 is the total sizes of the other collumns
SendMessage_(GadgetID(#Gadget_cabboy_List_Members), #LVM_SETCOLUMNWIDTH , 0, NewCollumn4Size.l) ; Set the new collumn size
;-----------------------------------------------------------------------------------------------------------------
ResizeGadget(#Gadget_cabboy_Main_Frame, 5 , 0 , 490 + WidthChange , 40)
ResizeGadget(#Gadget_cabboy_Cab_Name_Label, 15 , 15 , 75 , 15)
ResizeGadget(#Gadget_cabboy_Cab_Name, 95 , 15 , 360 + WidthChange , 15)
ResizeGadget(#Gadget_cabboy_Set_Pack_Name, 460 + WidthChange, 15 , 25 , 15)
ResizeGadget(#Gadget_cabboy_List_Frame, 5 , 40 , 490 + WidthChange , 310 + HeightChange)
ResizeGadget(#Gadget_cabboy_List_Members, 15 , 55 , 470 + WidthChange , 285 + HeightChange)
ResizeGadget(#Gadget_cabboy_Control_Frame, 5 , 350 + HeightChange, 490 + WidthChange , 45)
ResizeGadget(#Gadget_cabboy_Add_Files, 15 , 365 + HeightChange, 50 , 20)
ResizeGadget(#Gadget_cabboy_Add_Directories,65 , 365 + HeightChange, 50 , 20)
ResizeGadget(#Gadget_cabboy_Make_Cab_File, 115 , 365 + HeightChange, 50 , 20)
ResizeGadget(#Gadget_cabboy_Exit_Program, 165 , 365 + HeightChange, 50 , 20)
ResizeGadget(#Gadget_cabboy_Status_Box, 220 , 370 + HeightChange, 265 + WidthChange , 15)
;-----------------------------------------------------------------------------------------------------------------
RedrawWindow_(WindowID(#Window_cabboy), 0, 0, #RDW_INVALIDATE) ; Make sure window gets redrawn properly
EndSelect
EndIf
ProcedureReturn Result
EndProcedure
;============================================================================================================================
; Custom routine to make cuter looking tool tips
;============================================================================================================================
Procedure Tool_Tip(Handle, Text.s)
ToolTipControl = CreateWindowEx_(0, "tooltips_class32", "", $D0000000 | #TTS_BALLOON, 0, 0, 0, 0, WindowID(#Window_cabboy), 0, GetModuleHandle_(0), 0)
SendMessage_(ToolTipControl, 1044, 0 ,0) ; ForeColor Tooltip
SendMessage_(ToolTipControl, 1043, $58F5D6, 0) ; BackColor Tooltip
SendMessage_(ToolTipControl, 1048, 0, 180) ; Maximum Width of tooltip
Button.TOOLINFO\cbSize = SizeOf(TOOLINFO)
Button\uFlags = $11
Button\hWnd = Handle
Button\uId = Handle
Button\lpszText = @Text.s
SendMessage_(ToolTipControl, $0404, 0, Button)
EndProcedure
;===========================================================================================================================
; Flash a message to the status bar whenever there is action happening
;===========================================================================================================================
Procedure Blink_Message()
SetWindowText_(WindowID(#Window_cabboy), ProgramVersion.s + " -- Working..")
TimerTicks + 1
If TimerTicks = 2
TimerTicks = 0
Reset_Title()
EndIf
EndProcedure
;===========================================================================================================================
; Reset the windows title to the program version. Used by a couple of routines
;===========================================================================================================================
Procedure Reset_Title()
SetWindowText_(WindowID(#Window_cabboy), ProgramVersion.s)
EndProcedure
;===========================================================================================================================
; Shorten the amount of typing we do for messages all to the same gadget
;===========================================================================================================================
Procedure Status_Message(Message.s)
SetGadgetText(#Gadget_cabboy_Status_Box, Message.s)
EndProcedure
;===========================================================================================================================
; Data section for bundled files
;===========================================================================================================================
DataSection
CabDll: IncludeBinary "cab10.dll"
EndCab:
EndDataSection
