Resource Files & Screen Resolution

Har du været oppe på JB\'s site og kigge

Nope...

Hvad er nu lige URL\'en til den?

OK - Jeg har besøgt hans site, men fandt desværre intet...

zerohero >> Jeg skal dybt beklage at eksemplet ikke findes på min side ... men her er et link til et tidligere svar jeg har givet i Eksperten til hvordan man kompilerer resourser ind i en exe fil ...

http://www.eksperten.dk/spm/59121

mht til sp. 2 så har borland været så flinke at implemtere en klasse ved avn Screen. Den ved en masse omkring din skærm, dog ikke hvem de sidder foran den :-)

Nå men prøs Screen.Width og Screen.Height du må selv gætte hvad de laver ....

Jens B

Borrisholt>> Jeg kender godt til Screen men jeg synes ikke at jeg kan finde noget omkring color-resolution. Hvordan kan jeg finde farve opløningen via Screen?

Borrisholt>> Det er lige netop det spørgsmål jeg også har set på. Det kan godt være at det virker med WAVE-filer (har ikke prøvet) men prøv lige med en BITMAP, så brokker Delphi sig og skriver følgende:

[Error] RLINK32: Unsupported 16bit resource in file \"hest.res\"

zerohero  >> Har lige brugt det forleden dan med gif billeder ...

Jens B

Det var da mærkligt jeg prøver lige en gang til - helt for fra...

Dette her står i min .pas fil lige under implementation for at linke test.res til min project:

implementation

{$R *.DFM}
{$R test.res}

Og dette her er hvad der står i min .res fil:

MyPic Bitmap \"face.bmp\"

Burde det ikke være nok - eller mangler jeg at tilføre et eller andet? og når jeg så kompiler er det at Delphi brokker sig.

Lad os tage det HELT forfra.

lav et nyt projekt, og gem det i et biblotek. I samme folder ligger du din wav fil.
Det skal lige siges at dette eksempel forudsætter du kalder din fil for correct.wav

Inde i Delphi vælger du File->New.. her fra vælger du så en Text. Som resultat af denne handling får du en alm text fil. (som endnu ikke er gemt, eller en del af dit projekt)

i din text fil skriver du så det følgende kode :

////// begin rc fil //////

//Name            TYPE            Filename
  MyPic          Bitmap        filnavn.bmp


////// end rc fil //////



Vælg file->Save As... Giv din text fil det ønskede navn, og HUST at ændere typen til en rc fil.

Der efter trykker du på tilføj fil knappen (den grønne plus) og til føjer din rc fil.

Så trykkes der på Compile, og vupti Construction complete. Nu er din wav fil en del af din exe fil !!!!!


Så skal vi bare have den hevet ud igen :

procedure ExtractFromRes(ResType, ResName : String);
begin
  with TResourceStream.Create(HINSTANCE, Resname, Pchar(ResType)) do
  try
    Position := 0;
    SaveToFile(\'C:\\\' + ResName + \'.bmp\');
  finally
    free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ExtractFromRes(\'Bitmap\', \'MyPic\');
end;


di skal altså IKKE bruge \" inde i din rc fil og du skal IKKE selv skrive {$R test.res}

Jens B

hvis du vil vide hvor mange farver du har på skaærmen så brug :

GetDeviceCaps(GetDC(0),BITSPIXEL);

Jens B

Hey BorrisHolt forresten ved du en kode der kan fortælle mig hvormange MB Ram jeg har på min computer og hvormange af dem der er fri?

ja

vil du dele den med os andre :) ???

Så pyt da, nå nu du lige frem spørger ....

I store træk skal du bruge  TMemoryStatus som du så kan hente diverse ting ud af ....

Jeg har skrevet et stører system info projekt. Som fortæller en masse rare ting om dit system. Nedenfor har du memory delen af det .....

Jeg mangler et stack dumt til min dims ... Måske det var et job for dig ?



unit Memory;


interface

uses
  SysUtils, Windows, Classes;

type
  TMemory = class(TPersistent)
  private
    FMaxAppAddress: integer;
    FVirtualTotal: integer;
    FPageFileFree: integer;
    FVirtualFree: integer;
    FPhysicalFree: integer;
    FAllocGranularity: integer;
    FMinAppAddress: integer;
    FMemoryLoad: integer;
    FPhysicalTotal: integer;
    FPageFileTotal: integer;
    FPageSize: integer;
    FGDIRes: Byte;
    FUserRes: Byte;
    FSystemRes: Byte;

    function GetSystemRes: Byte;
    function GetGDIRes: Byte;
    function GetUSERRes: Byte;
  public
    procedure GetInfo;
    procedure Report(var sl :TStringList);
  published
    property PhysicalTotal :integer read FPhysicalTotal write FPhysicalTotal stored false;
    property PhysicalFree :integer read FPhysicalFree write FPhysicalFree stored false;
    property VirtualTotal :integer read FVirtualTotal write FVirtualTotal stored false;
    property VirtualFree :integer read FVirtualFree write FVirtualFree stored false;
    property PageFileTotal :integer read FPageFileTotal write FPageFileTotal stored false;
    property PageFileFree :integer read FPageFileFree write FPageFileFree stored false;
    property MemoryLoad :integer read FMemoryLoad write FMemoryLoad stored false;
    property AllocGranularity :integer read FAllocGranularity write FAllocGranularity stored false;
    property MaxAppAddress :integer read FMaxAppAddress write FMaxAppAddress stored false;
    property MinAppAddress :integer read FMinAppAddress write FMinAppAddress stored false;
    property PageSize :integer read FPageSize write FPageSize stored false;
    property Win9x_SystemRes: Byte read FSystemRes write FSystemRes stored false;
    property Win9x_GDIRes: Byte read FGDIRes write FGDIRes stored false;
    property Win9x_UserRes: Byte read FUserRes write FUserRes stored false;
  end;

implementation


{$IFDEF ONLYWIN9X}
const
  cSystem = 0;
  cGDI = 1;
  cUSER = 2;

type
  function LoadLibrary16(LibraryName: PChar): THandle; stdcall; external kernel32 index 35;
  procedure FreeLibrary16(HInstance: THandle); stdcall; external kernel32 index 36;
  function GetProcAddress16(Hinstance: THandle; ProcName: PChar): Pointer; stdcall; external kernel32 index 37;
  procedure QT_Thunk; cdecl; external kernel32 name \'QT_Thunk\';
var
  hInst16: THandle;
  SR: Pointer;

function GetFreeSysRes(SysRes: Word): Word;
var
  Thunks: Array[0..$20] of Word;
begin
  Thunks[0]:=hInst16;
  hInst16:=LoadLibrary16(\'user.exe\');
  if hInst16<32 then
    raise Exception.Create(\'Can\'\'t load USER.EXE!\');
  FreeLibrary16(hInst16);
  SR:=GetProcAddress16(hInst16,\'GetFreeSystemResources\');
  if not Assigned(SR) then
    raise Exception.Create(\'Can\'\'t get address of GetFreeSystemResources\');
  asm
    push SysRes      // push arguments
    mov edx, SR      // load 16-bit procedure pointer
    call QT_Thunk    // call thunk
    mov Result, ax    // save the result
  end;
end;
{$ENDIF}

{ TMemory }

function TMemory.GetGDIRes: Byte;
begin
  {$IFDEF ONLYWIN9X}
  Result:=GetFreeSysRes(cGDI)
  {$ELSE}
  Result:=0;
  {$ENDIF}
end;

function TMemory.GetSystemRes: Byte;
begin
  {$IFDEF ONLYWIN9X}
  Result:=GetFreeSysRes(cSystem)
  {$ELSE}
  Result:=0;
  {$ENDIF}
end;

function TMemory.GetUSERRes: Byte;
begin
  {$IFDEF ONLYWIN9X}
  Result:=GetFreeSysRes(cUser)
  {$ELSE}
  Result:=0;
  {$ENDIF}
end;

procedure TMemory.GetInfo;
var
  SI :TSystemInfo;
  MS :TMemoryStatus;
begin
  ZeroMemory(@MS,SizeOf(MS));
  MS.dwLength:=SizeOf(MS);
  GlobalMemoryStatus(MS);
  MemoryLoad:=MS.dwMemoryLoad;
  PhysicalTotal:=MS.dwTotalPhys;
  PhysicalFree:=MS.dwAvailPhys;
  VirtualTotal:=MS.dwTotalVirtual;
  VirtualFree:=MS.dwAvailVirtual;
  PageFileTotal:=MS.dwTotalPageFile;
  PageFileFree:=MS.dwAvailPageFile;
  ZeroMemory(@SI,SizeOf(SI));
  GetSystemInfo(SI);
  AllocGranularity:=SI.dwAllocationGranularity;
  MaxAppAddress:=DWORD(SI.lpMaximumApplicationAddress);
  MinAppAddress:=DWORD(SI.lpMinimumApplicationAddress);
  PageSize:=DWORD(SI.dwPageSize);
  FSystemRes:=GetSystemRes;
  FGDIRes:=GetGDIRes;
  FUserRes:=GetUserRes;
end;

procedure TMemory.Report(var sl: TStringList);
begin
  with sl do begin
    Add(\'[Memory]\');
    Add(FormatFloat(\'PhysMemTotal=0,##\',PhysicalTotal));
    Add(FormatFloat(\'PhysMemFree=0,##\',PhysicalFree));
    Add(FormatFloat(\'PageFileTotal=0,##\',PageFileTotal));
    Add(FormatFloat(\'PageFileFree=0,##\',PageFileFree));
    Add(FormatFloat(\'VirtMemTotal=0,##\',VirtualTotal));
    Add(FormatFloat(\'VirtMemFree=0,##\',VirtualFree));
    Add(FormatFloat(\'AllocGranularity=0,##\',AllocGranularity));
    Add(Format(\'MinAppAddress=%x\',[MinAppAddress]));
    Add(Format(\'MaxAppAddress=%x\',[MaxAppAddress]));
    Add(FormatFloat(\'PageSize=0,##\',PageSize));
  end;
end;


end.


Jens B

1000 tak Borrisholt...

men hvad betyder

\"Jeg mangler et stack dumt til min dims\"

ZeroHero

hov STACK DUMP.

Noget kode er kan læser hele stackeni gennem og dumper den ud på skærmen ...

Jens B